Draft produced by Dr. Michele Claibourn and Michael Salgueiro for Accountability Metrics Committee meeting on February 2nd, 2022
Below we provide an initial view of potential visualizations for accountability metrics, focusing on potential outcomes identified by the Pipelines and Pathways working group: (1) the degree to which families in the Charlottesville region are struggling with less than family-sustaining wages and (2) UVA’s contribution to providing jobs with family-sustaining wages to the community.1
library(tidyverse)
library(ggthemes)
# library(patchwork)
library(plotly)
fsw <- readRDS("family_income_all.RDS")
fsw_race <- readRDS("family_income_race.rDS")Many families struggle to afford the essentials – food, clothing, shelter, and utilities – plus the expenses necessary to hold a job – transportation and childcare. The figures below show the number and percent of families in the Charlottesville region whose annual income is below $35,000.2
loc_num <- fsw %>%
filter(income != "$35,000 or more") %>%
ggplot(aes(x = year, y = families, fill = income, label = percent)) +
geom_area() +
scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
scale_fill_brewer(name = "Income Range", palette = "BuPu") +
labs(y = "# of Families Struggling") +
theme_minimal()
loc_per <- fsw %>%
filter(income != "$35,000 or more") %>%
group_by(year) %>%
summarize(families = sum(families),
total = first(total)) %>%
mutate(percent_families = round(families/total*100, 1)) %>%
ggplot(aes(x = year, y = percent_families, label = families)) +
geom_line() +
annotate("text", x = 2019, y = 17.4, label = "15.4%", color = "#88419d") +
coord_cartesian(xlim = c(2009, 2019),
clip = 'off') +
scale_y_continuous(name = "% of Families Struggling", limits = c(0,30)) +
scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
theme_clean()
subplot(loc_num, loc_per, nrows = 2, shareX = T,
titleX = T, titleY = T, which_layout = 1) %>%
layout(
yaxis = list(
dtick = 2000,
tick0 = 0,
tickmode = "linear"
))loc_race_num <- fsw_race %>%
filter(income != "$35,000 or more") %>%
group_by(year, race) %>%
summarize(families = sum(families),
total = first(total)) %>%
mutate(percent_families = round(families/total*100, 1)) %>%
ggplot(aes(x = year, y = families, fill = race, label = percent_families)) +
geom_area() +
scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
scale_fill_brewer(name = "Family Race", palette = "Set1") +
labs(y = "# of Families Struggling") +
theme_minimal()
loc_race_per <- fsw_race %>%
filter(income != "$35,000 or more") %>%
group_by(year, race) %>%
summarize(families = sum(families),
total = first(total)) %>%
mutate(percent_families = round(families/total*100, 1)) %>%
ggplot(aes(x = year, y = percent_families, color = race, label = families)) +
geom_line() +
scale_color_brewer(name = "Family Race", palette = "Set1") +
scale_y_continuous(name = "% of Families Struggling", breaks = seq(10,60,10)) +
scale_x_continuous(name = "", breaks = seq(2009, 2019, 1)) +
theme_bw()
subplot(loc_race_num, loc_race_per, nrows = 2, shareX = T,
titleX = T, titleY = T, which_layout = 1) %>%
layout(
yaxis = list(
dtick = 2000,
tick0 = 0,
tickmode = "linear"
)) %>%
style(showlegend = FALSE, traces = 6:12)Here we could show the estimated expenses over time (the necessary information is accessible but not yet collated).
We don’t currently have access to relevant data but suggestions based on conversations have included:
Proposed metrics to understand multiple year trends in entry-level workforce composition include:
Additionally, there may be interest in understanding the scale, if not the composition, of contract workers at the University. A possible metric may be:
These figures might be updated annually or at some other meaningful period of time.
Possibilites that have risen in conversation include
Here we imagine a table providing information on new and ongoing initiatives, policy changes, partner progams, or other interventions intended to create pipelines for targeted local residents into UVA employment and to forge pathways for job advancement.
library(reactable)
library(htmltools)
library(googlesheets4)
# functions ----
# Function needed according to Greg Lin, creator of reactable
html <- function(x, inline = FALSE) {
container <- if (inline) htmltools::span else htmltools::div
container(dangerouslySetInnerHTML = list("__html" = x))
}
# Render a bar chart with a label on the left
# from tutorial: https://glin.github.io/reactable/articles/building-twitter-followers.html
bar_chart <- function(label, width = "100%", height = "14px", fill = "#00bfc4", background = NULL) {
bar <- div(style = list(background = fill, width = width, height = height))
chart <- div(style = list(flexGrow = 1, marginLeft = "6px", background = background), bar)
div(style = list(display = "flex", alignItems = "center"), label, chart)
}
# read data
status <- read_sheet("https://docs.google.com/spreadsheets/d/1Jz-Z3UGs8o5HE9YmckMyUPyp33pA9HXmgrI-mLcnR9Q/edit#gid=294144601",
sheet = "table")
# split subitems
status <- status %>%
mutate(Activities = str_split(status$Activities, ";"))
# make table
reactable(status,
columns = list(
Activities = colDef(show = FALSE),
`Creating New Pipelines` = colDef(minWidth = 300),
`2022 Stage` = colDef(align = "center",
style = function(value) {
if (value == "E") {
color <- "#fee6ce"
} else if (value == "I") {
color <- "#fdae6b"
} else {
color <- "#e6550d"
}
list(background = color, fontWeight = "bold")
}),
`Time Period` = colDef(
# Render the bar charts using a custom cell render function
cell = function(value) {
if (value == "Short") {
width = 25
} else if (value == "Mid") {
width = 50
} else if (value == "Long") {
width = 75
} else {
width = 100
}
bar_chart(value, width = width, fill = "#08519c")
},
# And left-align the columns
align = "left"
),
`Accountable Organization` = colDef(align = "center")
),
# if there additional activities, make row expandable
details = function(index) {
if(!is.na(status$Activities[index])) {
ul <- tags$ul()
list <- unlist(status$Activities[index])
ul$children <- lapply(seq_len(length(list)), function(index) {
tags$li(list[index])
})
ul
}
}
)legend <- read_sheet("https://docs.google.com/spreadsheets/d/1Jz-Z3UGs8o5HE9YmckMyUPyp33pA9HXmgrI-mLcnR9Q/edit#gid=294144601",
sheet = "legend")
legend <- legend %>%
mutate(`Current Stage (Q1 2022)` = ifelse(is.na(`Current Stage (Q1 2022)`), "", `Current Stage (Q1 2022)`))
reactable(legend,
width = 500,
columns = list(
`Current Stage (Q1 2022)` = colDef(align = "center",
style = function(value) {
if (value == "Explore (E)") {
color <- "#fee6ce"
} else if (value == "Implement (I)") {
color <- "#fdae6b"
} else if (value == "Complete (C)") {
color <- "#e6550d"
} else {
color <- "white"
}
list(background = color, fontWeight = "bold")
}),
`Anticipated Time (as of Q1 2022)` = colDef(
# Render the bar charts using a custom cell render function
cell = function(value) {
if (value == "Year 1 (Short)") {
width = 25
} else if (value == "Years 2-3 (Mid)") {
width = 50
} else if (value == "Years 4+ (Long)") {
width = 75
} else {
width = 100
}
bar_chart(value, width = width, fill = "#08519c")
},
# And left-align the columns
align = "left"
)
)
)Following the work of the Orange Dot report, in this initial draft we define the Charlottesville region as the city of Charlottesville, Albemarle County, Buckingham County, Fluvanna County, Greene County, Louisa County, and Nelson County. This can be altered in accord with the consensus of the working groups.↩︎
Estimates of the number and percent of families with incomes below $35,000 are based on American Community Survey 5-year estimates (Table B19101). The 2005-2009 estimates are used for the 2009 measure, 2006-2010 estimates are used for the 2010 measure, and so on. The U.S Census Bureau discourages making over time comparisons based on data with overlapping estimates (see here for more) to infer change, as the estimates are based much of the same data. We would refrain from making inferential statements about trends from year to year, but can use them to understand longer-term (e.g., 10-year) changes. Alternatively, we could choose to use the ACS 1-year estimates as provided in Table B19101 for the Charlottesville Metropolitian Statistical Area which includes the city of Charlottesville, Albemarle County, Fluvanna County, Greene County, and Nelson County but not Louisa County which is part of the regional planning district (or Buckingham County, which is not part of the regional planning district). An additional possibility is to use the Public Use Microdata Samples provided by the Census for the two Public Use Microdata Areas comprising the Thomas Jefferson planning district to derive the estimates. This route could also allow us to estimate familiy-sustaining wages for population categories in addition to race and ethnicity, but will also be more labor-intensive.↩︎
Defined disadvantaged groups, as per ‘Pipelines & Pathways Working Group: Report and Recommendations’ (2022): a) Black, Latino/a and Asian; b) Criminal-justice involved; c) People with disabilities; d) Women; e) English language learners; f) Adults with no High School diploma or equivalent; g) Low income; h) Technology challenged; i) Parents without access to affordable childcare.↩︎
To be defined by Working Group. One area for reform is around misaligned educational requirements, as per the recommendations in ‘Pipelines & Pathways Working Group: Report and Recommendations’ (2022).↩︎